home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / mosmllib / Help.mlp < prev    next >
Encoding:
Text File  |  1997-08-18  |  9.7 KB  |  327 lines  |  [TEXT/R*ch]
  1. (* Help -- a simple Moscow ML library browser, PS 1995-04-30, 1995-11-20
  2.  
  3. Using a signature index database, 
  4.  
  5. Uses argv_ to get the library directory, then reads and displays
  6. (signature) files from that directory.
  7.  
  8. The search facility cyclically searches for occurrences of a given
  9. string, and displays the line in which the string was found, as close
  10. to the center of the display (or portion displayed) as possible.
  11.  
  12. *)
  13.  
  14. (* The number of lines to show interactively: *)
  15.  
  16. val displayLines = ref 24
  17.  
  18. local
  19. fun print s = TextIO.print s
  20.  
  21. (* Name of the signature index database, must reside in the std library: *)
  22.  
  23. val dbfilename = "helpsigs.val"
  24.  
  25. (* The database reading and searching functions.  Included here only
  26.  * to avoid loading yet another structure.  Types MUST agree with unit
  27.  * Database in mosml/src/toolssrc. *)
  28.  
  29. datatype component = 
  30.     Str                    (* structure                       *)
  31.   | Exc of string            (* exception constructor with name *)
  32.   | Typ of string            (* type constructor with name      *)
  33.   | Val of string            (* value with name                 *)
  34.   | Con of string            (* value constructor with name       *)
  35.  
  36. type entry = { comp : component, str : string, line : int }
  37.  
  38. datatype 'contents table =
  39.     Empty
  40.   | Node of string * 'contents * 'contents table * 'contents table
  41.  
  42. type database = entry list table
  43.  
  44. fun readbase filename =
  45.     let prim_type in_channel 
  46.     type instream_  = { closed: bool, ic: in_channel } ref
  47.     prim_val input_value_ : in_channel -> 'a = 1 "intern_val"
  48.     prim_val fromI : BasicIO.instream -> instream_   = 1 "identity"
  49.         fun input_value is =
  50.         let val ref {closed, ic} = fromI is in
  51.         if closed then
  52.             raise SysErr("Input stream is closed", NONE)
  53.         else
  54.             input_value_ ic
  55.         end
  56.     val is = BasicIO.open_in_bin filename
  57.     val db = input_value is : database
  58.     in BasicIO.close_in is; db end
  59.  
  60. fun lookup(db : database, sought : string) =
  61.     let fun look Empty                      = []
  62.       | look (Node(key, value, t1, t2)) =
  63.         if sought < key then look t1
  64.         else if key < sought then look t2
  65.         else value
  66.     in look db end
  67.  
  68. (* The global variable holding the database after the first use: *)
  69.  
  70. val dbOpt = ref NONE : database option ref;
  71.  
  72. (* Auxiliaries: *)
  73.  
  74. fun min (x, y) = if x < y then x else y : int;
  75. fun max (x, y) = if x < y then y else x : int;
  76.  
  77. fun natFromString s =
  78.     let fun skipWS []              = []
  79.       | skipWS (cs as (c::cr)) = if Char.isSpace c then skipWS cr else cs
  80.     fun decval c = Char.ord c - 48
  81.     fun h []      res = SOME res
  82.       | h (c::cr) res = if Char.isDigit c then h cr (decval c + 10 * res)
  83.                 else SOME res
  84.     in 
  85.     case skipWS (String.explode s) of
  86.         []    => NONE
  87.       | c::cr => if Char.isDigit c then h cr (decval c)
  88.              else NONE
  89.     end
  90.  
  91. fun natToString n =
  92.     (if n > 9 then natToString (n div 10) else "") 
  93.      ^ String.str (Char.chr(48 + n mod 10))
  94.     
  95. fun normalize []           = []
  96.   | normalize (#"\n" :: _) = []
  97.   | normalize (c :: cr)    = Char.toLower c :: normalize cr
  98.  
  99. fun toLower s = String.implode (normalize (String.explode s))
  100.  
  101. #ifdef macintosh
  102. val slash = #":"
  103. #else (* DOS/UNIX *)
  104. val slash = #"/"
  105. #endif  
  106.  
  107. fun joinDirFile dir file =
  108.     let open String 
  109.     in 
  110.     if dir <> "" andalso sub(dir, size dir - 1) = slash then 
  111.         dir ^ file
  112.     else
  113.         dir ^ str slash ^ file        
  114.     end
  115.  
  116. (* The signature browser: *)
  117.  
  118. fun show name centerline initiallySought (strs : string Vector.vector) = 
  119.     let prim_val sub_ : string -> int -> char = 2 "get_nth_char";
  120.     prim_val int_to_string : int -> string = 1 "sml_string_of_int";
  121.  
  122.     val lines = Vector.length strs
  123.     val sought = ref initiallySought
  124.     fun instr s str =
  125.         let val len = String.size s
  126.         fun eq j k = 
  127.             j >= len orelse 
  128.             sub_ s j = Char.toLower (sub_ str k) andalso eq (j+1) (k+1)
  129.         val stop = String.size str - len
  130.         fun cmp k = k<=stop andalso (eq 0 k orelse cmp(k+1))
  131.         in cmp 0 end;
  132.     fun occurshere str = 
  133.         case !sought of
  134.         NONE   => false
  135.           | SOME s => instr s str
  136.     fun findline s curr = 
  137.         let fun h i = 
  138.         if i >= lines then NONE
  139.         else if instr s (Vector.sub(strs, (i+curr) mod lines)) then 
  140.             SOME ((i + curr) mod lines)
  141.         else h(i+1)
  142.         in h 0 end
  143.     val portion = max(!displayLines, 5) - 1
  144.     fun wait next = 
  145.         let val prompt = 
  146.         "---- " ^ name ^ "[" ^ 
  147.         int_to_string((100 * next) div lines) 
  148.         ^ "%]: down, up, bottom, top, /(find), next, quit: "
  149.         fun toend () = (print "\n....\n"; 
  150.                 nextpart (lines - portion) portion)
  151.         fun tobeg () = (print "\n....\n"; nextpart 0 portion)
  152.         fun up   ()  = (print "\n....\n"; 
  153.                 nextpart (next-3*portion div 2) portion)
  154.         fun down ()  = if next=lines then toend()
  155.                    else nextpart next (portion div 2)
  156.         fun find s =
  157.             case findline s next of
  158.             NONE      => 
  159.                 (print ("**** String \"" ^ s ^ "\" not found\n"); 
  160.                  wait next)
  161.               | SOME line => 
  162.                 (print "\n....\n";
  163.                  nextpart (line - portion div 2) portion)
  164.         fun search chars = 
  165.             let val s = String.implode (normalize chars)
  166.             in sought := SOME s; find s end
  167.         fun findnext () =
  168.             (case !sought of
  169.              NONE   => (print "**** No previous search string\n"; 
  170.                     wait next)
  171.                | SOME s => find s)
  172.         in 
  173.         print prompt;
  174.         case String.explode(BasicIO.input_line BasicIO.std_in) of
  175.             []        => ()
  176.           | #"q" :: _ => ()
  177.           | #"u" :: _ => up ()
  178.           | #"d" :: _ => down ()
  179.           | #"t" :: _ => tobeg ()
  180.           | #"g" :: _ => tobeg ()
  181.           | #"b" :: _ => toend ()
  182.           | #"G" :: _ => toend ()
  183.                   | #"/" :: s => search s
  184.                   | #"n" :: s => findnext ()
  185.           | _         => if next=lines then toend ()
  186.                  else nextpart next portion
  187.         end
  188.     and nextpart first amount = 
  189.         let val start = max(0, min(lines - amount + 1, first))
  190.         val stop  = min(start + amount, lines)
  191.         in prt wait start stop end
  192.     and prt wait i stop = 
  193.         if i >= stop then wait i
  194.         else 
  195.         let val line = Vector.sub(strs, i) 
  196.         in 
  197.             if occurshere line then print "@>" else print "+ ";
  198.             print line; 
  199.             prt wait (i+1) stop
  200.         end
  201.     in 
  202.     print "\n";
  203.     if lines <= portion then prt ignore 0 lines
  204.     else nextpart (centerline - portion div 2) portion
  205.     end
  206.  
  207. (* Find the standard library directory: *)
  208.  
  209. fun getstdlib () = 
  210.     let open Vector
  211.     prim_val argv_ : string vector = 0 "command_line";
  212.     val stop = length argv_ - 1;
  213.     fun h i = 
  214.         if i < stop then 
  215.         if sub(argv_, i) = "-stdlib" then sub(argv_, i+1)
  216.         else h (i+1)
  217.         else
  218.         raise Fail "Cannot find the standard libraries!"
  219.     in h 0 end;
  220.  
  221. (* Read a signature file from the standard library: *)
  222.  
  223. fun readfile file = 
  224.     let val is = BasicIO.open_in (joinDirFile (getstdlib ()) file)  
  225.     fun h () = if BasicIO.end_of_stream is then []
  226.            else BasicIO.input_line is :: h ()
  227.     in Vector.fromList (h ()) end;
  228.  
  229. (* Invoke the browser on a particular line of a signature: *)
  230.  
  231. fun showFile sought entry = 
  232.     (case entry of 
  233.      {comp = Str, str, ...} => 
  234.          show str 0 NONE (readfile (str ^ ".sig"))
  235.        | {comp, str, line} => 
  236.          show str line (SOME sought) (readfile (str ^ ".sig")))
  237.     handle SysErr _ => raise Fail "Help.showFile: inconsistent help database"
  238.  
  239. (* Let the user select from the menu: *)
  240.  
  241. fun choose sought entries =
  242.     let val _ = print "\nChoose number to browse, or quit: ";
  243.     val response = BasicIO.input_line BasicIO.std_in
  244.     in 
  245.     case natFromString response of
  246.         NONE => (case String.explode response of
  247.               []        => ()
  248.                     | [#"\n"]   => ()
  249.             | #"Q" :: _ => () 
  250.             | #"q" :: _ => () 
  251.             | _         => choose sought entries)
  252.       | SOME choice => 
  253.         if choice = 0 then ()
  254.         else showFile sought (List.nth(entries, choice - 1))
  255.     end
  256.     handle Subscript => choose sought entries
  257.      | Overflow  => choose sought entries;
  258.  
  259. (* Display the menu of identifiers matching the given one, or
  260.  * invoke the browser directly if only one match: 
  261.  *)
  262.  
  263. fun display sought []                  = raise Fail "Help.display"
  264.   | display sought [entry]             = showFile sought entry
  265.   | display sought (entries as e0::er) = 
  266.     let fun render (entry as {comp, str, ...}) =
  267.         case comp of
  268.         Str    => "structure " ^ str
  269.           | Exc id => "exn  " ^ str ^ "." ^ id
  270.           | Typ id => "type " ^ str ^ "." ^ id
  271.           | Val id => "val  " ^ str ^ "." ^ id
  272.           | Con id => "con  " ^ str ^ "." ^ id
  273.     fun maxlen []         max = max
  274.       | maxlen (e1 :: er) max = 
  275.         let val len = size (render e1)
  276.         in maxlen er (if len > max then len else max) end
  277.     val maxwidth = maxlen er (size (render e0))
  278.     val boxwidth = 6 + 3 + 3 + maxwidth + 2
  279.     val horizontal = StringCvt.padRight #"-" boxwidth "    " ^ "\n"
  280.  
  281.     fun prline lin [] = ()
  282.       | prline lin (e1 :: rest) =
  283.         (print "    | "; 
  284.          print (StringCvt.padLeft #" " 3 (natToString lin)); 
  285.          print " | ";
  286.          print (StringCvt.padRight #" " maxwidth (render e1)); 
  287.          print " |\n";
  288.          prline (lin+1) rest)
  289.     in 
  290.     print "\n"; 
  291.     print horizontal;
  292.     prline 1 entries;
  293.     print horizontal;
  294.     choose sought entries
  295.     end
  296.  
  297. in
  298.  
  299. (* Main help function: search for a string in the signature index database: *)
  300.             
  301. fun help "" =
  302.     show "help" 0 NONE 
  303.      #["Moscow ML library browser: \n",
  304.        "\n",
  305.        "   help \"lib\";   gives an overview of the library units\n",
  306.        "   help \"id\";    provides help on identifier id\n",
  307.        "\n"]
  308.   | help "lib" = show "Overview" 0 NONE (readfile "README")
  309.   | help "README" = show "README" 0 NONE (readfile "README")
  310.   | help id = 
  311.     let fun getdb filename = 
  312.           case !dbOpt of 
  313.         SOME db => db
  314.           | NONE    => 
  315.             let val db = readbase (joinDirFile (getstdlib ()) filename)
  316.             in dbOpt := SOME db; db end
  317.         handle SysErr _ => raise Fail "Cannot read help database!"
  318.     val db = getdb dbfilename
  319.     val sought = toLower id
  320.     val entries = lookup(db, sought)
  321.     in 
  322.     case entries of
  323.         [] => print ("\nSorry, no help on identifier `" ^ id ^ "'\n\n")
  324.       | _  => display sought entries
  325.     end
  326. end
  327.